{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE InstanceSigs,ScopedTypeVariables#-}
module App.UserCenter.Core (
  updateUser,
  replacePwd,
  miniRegisterUser,
  getLoginUser,
  loginUser,checkLogin,
  setCaptchaSession,logout,
  getLoginUserId,
  getLoginUserAndId
) where
import Database.Persist
import Database.Persist.Sqlite
import App.UserCenter.DB
import qualified Data.Time as DT
import qualified Data.Text as T
import Control.Monad
import App.Common.Types
import App.Common.Helper
import Control.Monad.IO.Unlift (MonadIO(..),MonadUnliftIO)
import Control.Monad.Trans.Reader (ReaderT)
import qualified App.UserCenter.UserTypes as UT
import Control.Monad.Trans.Except
import Control.Error.Safe
import Control.Monad.Trans
import Data.Maybe
import Data.String.Conversions
import Control.Monad.Trans.Maybe
import Control.Error.Util
import qualified Data.ByteString as BS
import qualified App.Common.Captcha as C
import Data.Default
import Data.Int

vcodeSessionKey = "vcode"

miniRegisterUser::(WebAppM m) => T.Text -> T.Text -> T.Text -> m (Either T.Text User)
miniRegisterUser account pwd vcode = runExceptT $ do
    eAcc   <- UT.parseAccount account
    ePwd   <- UT.parsePassword pwd
    eVCode <- UT.parseConstLenText vcode (==) 6 "验证码格式错误"
    _miniRegisterUser eAcc ePwd eVCode

_miniRegisterUser::(WebAppM m) => UT.Account -> UT.Password -> UT.ConstLenText -> ExceptT T.Text m User
_miniRegisterUser user pwd vcode = do
      mVCode <- lift $ lookupSession vcodeSessionKey
      tryAssert "验证码错误" (fromMaybe "" mVCode == showText vcode)
      mUser::Maybe (Entity User) <- lift $ runDB $ getBy $ UniqueAccount (showText user)
      tryAssert "名称已被注册" (isNothing mUser)
      lift $ deleteSession vcodeSessionKey
      lift $ runDB $ do
           dbUser <- liftIO defUser
           _ <- insert dbUser {userAccount =  (showText user),
                               userPassword = (toMD5.showText $ pwd),
                               userNickName = (showText user)}
           return dbUser

loginUser::(WebAppM m) => T.Text -> T.Text -> m (Either T.Text ())
loginUser account pwd = runExceptT $ do
    eAcc <- UT.parseAccount account
    ePwd <- UT.parsePassword pwd
    mUser::Maybe (Entity User) <- lift $ runDB $ getBy $ UniqueAccount (showText eAcc)
    case mUser of
      Nothing  -> throwE "用户名错误"
      Just (Entity k usr) -> if (userPassword usr) == (toMD5.showText $ ePwd)
                                then do
                                      let strKey = cs.show.fromSqlKey $ k
                                      lift $ setSession "login" strKey
                                      liftIO $ print strKey
                                      return ()
                                else throwE "密码错误"

checkPwd::(SqlDB m) => T.Text -> T.Text -> m Bool
checkPwd acc pwd = do
    let md5Pwd = toMD5 pwd
    count <- runDB $ count [UserAccount==.acc,UserPassword==.md5Pwd]
    --liftIO $ putStrLn $ (show count) <> "!!!!!!!!!!!!!!!!" <> cs md5Pwd <> "---" <> cs acc <> "--" <> cs pwd
    return (count > 0)

replacePwd::(SqlDB m) => T.Text -> T.Text -> T.Text -> m (Either T.Text T.Text)
replacePwd account pwd newPwd = runExceptT $ do
    _ <- UT.parsePassword newPwd
    let md5NewPwd = toMD5 newPwd
    isSucc <- lift $ checkPwd account pwd
    tryAssert "密码错误" isSucc
    lift $ runDB $ updateWhere [UserAccount==.account] [UserPassword=.md5NewPwd]
    return md5NewPwd

getLoginUser::(WebAppM m) => m (Maybe User)
getLoginUser = runMaybeT $ do
    maySess <- lift $ lookupSession "login"
    sess <- hoistMaybe maySess
    let userId = read $ cs sess
    mayUser::Maybe User <- lift $ runDB $ get $ toSqlKey userId
    hoistMaybe mayUser

getLoginUserId::(WebAppM m) => m (Maybe Int64)
getLoginUserId = runMaybeT $ do
    maySess <- lift $ lookupSession "login"
    sess <- hoistMaybe maySess
    return $ read $ cs sess

getLoginUserAndId::(WebAppM m) => m (Maybe (Int64,User))
getLoginUserAndId = runMaybeT $ do
   mUid  <- lift $ getLoginUserId
   mUser <- lift $ getLoginUser
   uid <- hoistMaybe mUid
   user <- hoistMaybe mUser
   return (uid,user)

checkLogin::(WebAppM m) => m Bool
checkLogin = lookupSession "login" >>= return.isJust

logout::(WebAppM m) => m ()
logout = deleteSession "login"

setCaptchaSession::(WebAppM m) => m (String,BS.ByteString)
setCaptchaSession = do
    (s,bytes) <- liftIO C.makeCaptcha
    setSession vcodeSessionKey $ (T.pack s)
    return (s,bytes)


updateUser::(WebAppM m) => T.Text -> Maybe T.Text -> T.Text -> Maybe T.Text -> Maybe T.Text -> m (Either T.Text ())
updateUser nickName email shortDesc qq headPic = runExceptT $ do
    maySess <- lift $ lookupSession "login"
    tryAssert "没有登录" (isJust maySess)
    let sess = fromMaybe "" maySess
    let key::Key User = toSqlKey (read $ cs sess)
    let upImage = maybe [] (\x-> [UserHeadImg=.x]) headPic
    lift $ runDB $ update key $ [UserNickName=.nickName,UserEmail =.email,
                                 UserShortDesc=.shortDesc,UserQq=.qq] <> upImage
    return ()

